Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/vssexa1a/frmvss.frm

Visual Basic Form | 1999-08-27 | 10.1 KB | 335 lines

VERSION 5.00
Begin VB.Form Form1
   Caption         =   "Form1"
   ClientHeight    =   7230
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6585
   LinkTopic       =   "Form1"
   ScaleHeight     =   7230
   ScaleWidth      =   6585
   StartUpPosition =   3  'Windows Default
   Begin VB.Frame Frame2
      Caption         =   "Files"
      Height          =   2415
      Left            =   120
      TabIndex        =   10
      Top             =   4680
      Width           =   6375
      Begin VB.ListBox lstFiles
         Height          =   2010
         Left            =   120
         MultiSelect     =   2  'Extended
         TabIndex        =   12
         Top             =   240
         Width           =   4575
      End
      Begin VB.CommandButton cmdGetFile
         Caption         =   "Get &File"
         Enabled         =   0   'False
         Height          =   495
         Left            =   4920
         TabIndex        =   11
         Top             =   240
         Width           =   1215
      End
   End
   Begin VB.Frame Frame1
      Caption         =   "Projects"
      Height          =   2415
      Left            =   120
      TabIndex        =   8
      Top             =   2160
      Width           =   6375
      Begin VB.CommandButton cmdGetProject
         Caption         =   "Get &Project"
         Enabled         =   0   'False
         Height          =   495
         Left            =   4920
         TabIndex        =   14
         Top             =   240
         Width           =   1215
      End
      Begin VB.CheckBox chkSubFolders
         Caption         =   "Show files in sub folders"
         Height          =   375
         Left            =   4800
         TabIndex        =   13
         Top             =   1920
         Width           =   1455
      End
      Begin VB.ListBox lstProjects
         Height          =   2010
         Left            =   120
         MultiSelect     =   2  'Extended
         TabIndex        =   9
         Top             =   240
         Width           =   4575
      End
   End
   Begin VB.CommandButton cmdExit
      Caption         =   "E&xit"
      Height          =   495
      Left            =   5040
      TabIndex        =   7
      Top             =   1440
      Width           =   1215
   End
   Begin VB.CommandButton cmdOpen
      Caption         =   "&Open VSS"
      Height          =   495
      Left            =   240
      TabIndex        =   6
      Top             =   1440
      Width           =   1215
   End
   Begin VB.TextBox txtPassword
      Height          =   285
      IMEMode         =   3  'DISABLE
      Left            =   2160
      PasswordChar    =   "*"
      TabIndex        =   5
      Top             =   960
      Width           =   4095
   End
   Begin VB.TextBox txtUserID
      Height          =   285
      Left            =   2160
      TabIndex        =   3
      Top             =   600
      Width           =   4095
   End
   Begin VB.TextBox txtINIPath
      Height          =   285
      Left            =   2160
      TabIndex        =   1
      Top             =   240
      Width           =   4095
   End
   Begin VB.Label Label2
      Alignment       =   1  'Right Justify
      Caption         =   "Password:"
      Height          =   255
      Left            =   240
      TabIndex        =   4
      Top             =   960
      Width           =   1695
   End
   Begin VB.Label Label1
      Alignment       =   1  'Right Justify
      Caption         =   "User ID:"
      Height          =   255
      Left            =   240
      TabIndex        =   2
      Top             =   600
      Width           =   1695
   End
   Begin VB.Label lblPath
      Alignment       =   1  'Right Justify
      Caption         =   "srcsafe.ini Path:"
      Height          =   255
      Left            =   240
      TabIndex        =   0
      Top             =   240
      Width           =   1695
   End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'*************************************************
'Date: 08/27/99 mg
'We have weekly (sometimes daily) builds of the
'software we are developing.  We have a build process
'that I have (for the most part) automated.  The only
'piece missing was the ability to interact with
'SourceSafe and get the files the developers wanted
'added to the build.  This project reads a source safe
'database and gets projects and files from it.  There
'is a MS article at
' http://msdn.microsoft.com/SSAFE/technical/articles/vssauto/VSSAuto.html
'that gives functionality
'possibilites that could be added.  If you have any
'questions, don't hesitate to send me an email.
'*************************************************
Dim vsdb As New VSSDatabase
Dim vsItem As VSSItem
Dim loopItem As VSSItem
Dim tabcount As Integer
Dim vsProjects() As String
Dim vsProjectSpecifics() As String
Private Sub cmdExit_Click()
  Unload Me
  End
End Sub
Private Sub cmdGetFile_Click()
Dim j%
    '
    'loop through the list to get all selected
    '
  For j = 0 To lstFiles.ListCount - 1
    If lstFiles.Selected(j) = True Then
        '
        'set the db current project to the selected file
        '
      vsdb.CurrentProject = vsProjectSpecifics(j + 1)
        '
        'set the item
        '
      Set vsItem = vsdb.VSSItem(vsdb.CurrentProject, False)
        '
        'get the file
        '
      vsItem.Get
    End If
  Next 'j
End Sub
Private Sub cmdGetProject_Click()
Dim j%
    '
    'loop through the list to get all selected
    '
  For j = 0 To lstProjects.ListCount - 1
    If lstProjects.Selected(j) = True Then
        '
        'set the db current project to the selected file
        '
      vsdb.CurrentProject = vsProjects(j + 1)
        '
        'set the item
        '
      Set vsItem = vsdb.VSSItem(vsdb.CurrentProject, False)
        '
        'get the project
        '
      vsItem.Get
    End If
  Next 'j
End Sub
Private Sub cmdOpen_Click()
Dim tmp$
    '
    'open a connection to the emerald database
    '
  If Right$(txtINIPath.Text, 1) <> "\" Then
    vsdb.Open txtINIPath.Text & "\srcsafe.ini", txtUserID.Text, txtPassword.Text
  Else
    vsdb.Open txtINIPath.Text & "srcsafe.ini", txtUserID.Text, txtPassword.Text
  End If
    '
    'look at the root project
    '
  vsdb.CurrentProject = "$/"
  tabcount = -1
  Call GetProjects(vsdb.CurrentProject)
End Sub
Sub GetProjectSpecifics(ProjectName$, Recursion As Boolean)
Dim gpfItem As VSSItem
Dim gpfLoop As VSSItem
Dim tmp$
  tabcount = tabcount + 1
  Set gpfItem = vsdb.VSSItem(ProjectName$, False)
    '
    'loop thru the items and add the names to a list box
    '
  For Each gpfLoop In gpfItem.Items(False)
    tmp$ = String$(tabcount, Chr$(9))
    If gpfLoop.Type = VSSITEM_PROJECT Then
        '
        'add to the list and add to the project array
        '
      lstFiles.AddItem tmp$ & gpfLoop.Name
      ReDim Preserve vsProjectSpecifics(UBound(vsProjectSpecifics) + 1)
      vsProjectSpecifics(UBound(vsProjectSpecifics)) = gpfLoop.Spec
      lstFiles.ItemData(lstFiles.NewIndex) = UBound(vsProjectSpecifics)
      If Recursion = True Then
          '
          'loop through any folders in this folder
          '
        If Right$(ProjectName$, 1) = "/" Then
          Call GetProjectSpecifics(ProjectName$ & gpfLoop.Name, Recursion)
        Else
          Call GetProjectSpecifics(ProjectName$ & "/" & gpfLoop.Name, Recursion)
        End If
      End If
    ElseIf gpfLoop.Type = VSSITEM_FILE Then
        '
        'add to the list and add to the project array
        '
      lstFiles.AddItem tmp$ & gpfLoop.Name
      ReDim Preserve vsProjectSpecifics(UBound(vsProjectSpecifics) + 1)
      vsProjectSpecifics(UBound(vsProjectSpecifics)) = gpfLoop.Spec
      lstFiles.ItemData(lstFiles.NewIndex) = UBound(vsProjectSpecifics)
    End If
  Next
  tabcount = tabcount - 1
End Sub
Sub GetProjects(ProjectName$)
Dim gpfItem As VSSItem
Dim gpfLoop As VSSItem
Dim tmp$
  tabcount = tabcount + 1
  Set gpfItem = vsdb.VSSItem(ProjectName$, False)
    '
    'loop thru the items and add the names to a list box
    '
  For Each gpfLoop In gpfItem.Items(False)
    tmp$ = String$(tabcount, Chr$(9))
    If gpfLoop.Type = VSSITEM_PROJECT Then
        '
        'add to the list and add to the project array
        '
      lstProjects.AddItem tmp$ & gpfLoop.Name
      ReDim Preserve vsProjects(UBound(vsProjects) + 1)
      vsProjects(UBound(vsProjects)) = gpfLoop.Spec
      lstProjects.ItemData(lstProjects.NewIndex) = UBound(vsProjects)
        '
        'loop through any folders in this folder
        '
      If Right$(ProjectName$, 1) = "/" Then
        Call GetProjects(ProjectName$ & gpfLoop.Name)
      Else
        Call GetProjects(ProjectName$ & "/" & gpfLoop.Name)
      End If
    End If
  Next
  tabcount = tabcount - 1
End Sub
Private Sub Form_Load()
  ReDim vsProjects$(0)
  ReDim vsProjectSpecifics$(0)
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
  Set vsdb = Nothing
End Sub
Private Sub lstFiles_Click()
  cmdGetFile.Enabled = True
End Sub
Private Sub lstProjects_Click()
  cmdGetProject.Enabled = True
End Sub
Private Sub lstProjects_DblClick()
    '
    'if the user clicks on a project, list all the files
    'for that project
    '
  vsdb.CurrentProject = vsProjects(lstProjects.ListIndex + 1)
  Set vsItem = vsdb.VSSItem(vsdb.CurrentProject, False)
    '
    'clear the previous files
    '
  lstFiles.Clear
  cmdGetFile.Enabled = False
    '
    'get sub folders if the user so desires
    '
  If chkSubFolders.Value = vbChecked Then
    Call GetProjectSpecifics(vsProjects(lstProjects.ListIndex + 1), True)
  Else
    Call GetProjectSpecifics(vsProjects(lstProjects.ListIndex + 1), False)
  End If
End Sub